unit StringUtils;

interface

uses
  Windows, SysUtils;

Function ValidStr10Date(Const Value: String): Boolean;
Function ValidStr8Date(Const Value: String): Boolean;

Function Str10ToDate(const value:String): TDateTime;
Function Str8ToDate(const value:String): TDateTime;

Function DateStrToDateTime( Const Value : String ) : TDateTime;
Function DateStrToDateFmt( Const Value, Fmt : String ) : String;
Function TimeStrToDateTime( Const Value : String ) : TDateTime;
Function TimeStrToDateFmt( Const Value, Fmt : String ) : String;

function DateTimeStrtoDT( const Value : String ) : TDateTime;
function DTtoDateTimeStr( aDt : TDateTime ) : String;

function SetFileDateTime(FileName: string; dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;
Function GetFileDateTime(FileName: string; var dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;

implementation

function DTtoFT(dt: TDateTime): TFiletime;
var
  ft : TFileTime;
  SysTimeStruct: SYSTEMTIME;
begin
  DateTimeToSystemTime(dt, SysTimeStruct );
  SystemTimeToFileTime( SysTimeStruct, ft );

  Result := ft;
end;

function FTtoDT( FileTime : TFileTime ) : TDateTime;
var
  SysTimeStruct: SYSTEMTIME;
begin
  Result := 0;
  if FileTimeToSystemTime(FileTime, SysTimeStruct) then
    Result := SystemTimeToDateTime(SysTimeStruct);
end;

Function GetFileDateTime(FileName: string; var dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;
var
  hDir: THandle;
  ftCreation: TFiletime;
  ftLastAccessTime: TFiletime;
  ftLastWriteTime: TFiletime;
begin
  hDir := CreateFile(PChar(FileName),
//                     GENERIC_READ or GENERIC_WRITE,
                     GENERIC_READ,
                     0,
                     nil,
                     OPEN_EXISTING,
                     FILE_FLAG_BACKUP_SEMANTICS,
                     0);
  if hDir <> INVALID_HANDLE_VALUE then
  begin
    try

      Result := GetFileTime( hDir, @ftCreation, @ftLastAccessTime, @ftLastWriteTime);

      if Result then
      begin
        dtCreation        := FTtoDT( ftCreation );
        dtLastAccessTime  := FTtoDT( ftLastAccessTime );
        dtLastWriteTime   := FTtoDT( ftLastWriteTime );
      end;

    finally
      CloseHandle(hDir);
    end;
  end
  else
    Result := False;
end;

function SetFileDateTime(FileName: string; dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;
var
  hDir: THandle;
  ftCreation: TFiletime;
  ftLastAccessTime: TFiletime;
  ftLastWriteTime: TFiletime;
begin
  hDir := CreateFile(PChar(FileName),
                     GENERIC_READ or GENERIC_WRITE,
                     0,
                     nil,
                     OPEN_EXISTING,
                     FILE_FLAG_BACKUP_SEMANTICS,
                     0);
  if hDir <> INVALID_HANDLE_VALUE then
  begin
    try
      ftCreation       := DTtoFT(dtCreation);
      ftLastAccessTime := DTtoFT(dtLastAccessTime);
      ftLastWriteTime  := DTtoFT(dtLastWriteTime);
      Result := SetFileTime(hDir, @ftCreation, @ftLastAccessTime, @ftLastWriteTime);
    finally
      CloseHandle(hDir);
    end;
  end
  else
    Result := False;
End;

Function ValidStr8Date(Const Value: String): Boolean;
Var
  y, m, d: Word;
Begin
  result := False;
  If Length(Value) <> 8 Then exit;

  Try
    y := StrToInt(copy(value, 1, 4));
    m := StrToInt(copy(value, 5, 2));
    d := StrToInt(copy(value, 7, 2));
    EncodeDate(Y, M, D);
  Except
    exit;
  End;

  Result := True;
End;

Function ValidStr10Date(Const Value: String): Boolean;
Var
  y, m, d: Word;
Begin
  result := False;
  If Length(Value) <> 10 Then exit;

  Try
    y := StrToInt(copy(value, 1, 4));
    m := StrToInt(copy(value, 6, 2));
    d := StrToInt(copy(value, 9, 2));
    EncodeDate(Y, M, D);
  Except
    exit;
  End;

  Result := True;
End;

Function Str10ToDate(const value:String): TDateTime;
var
y,m,d: Word;
begin
  try
    y := StrToInt( copy(value,1,4) );
    m := StrToInt( copy(value,6,2) );
    d := StrToInt( copy(value,9,2) );
  Except
    y := StrToInt( formatDateTime('yyyy', now) );
    m := StrToInt( formatDateTime('mm', now) );
    d := StrToInt( formatDateTime('dd', now) );
  end;

  Result := EncodeDate(Y, M, D);
end;

Function Str8ToDate(const value:String): TDateTime;
var
y,m,d: Word;
begin
  try
    y := StrToInt( copy(value,1,4) );
    m := StrToInt( copy(value,5,2) );
    d := StrToInt( copy(value,7,2) );
  Except
    y := StrToInt( formatDateTime('yyyy', now) );
    m := StrToInt( formatDateTime('mm', now) );
    d := StrToInt( formatDateTime('dd', now) );
  end;

  Result := EncodeDate(Y, M, D);
end;

Function DateStrToDateTime( Const Value : String ) : TDateTime;
var
  dt: TDateTime;
  y, m, d: Word;
begin
  Result := 0;
  if Length( Value ) = 8 then begin
    if not ValidStr8Date( Value ) then Exit;
    y := StrToInt(copy(value, 1, 4));
    m := StrToInt(copy(value, 5, 2));
    d := StrToInt(copy(value, 7, 2));
  end else if Length( Value ) = 10 then begin
    if not ValidStr10Date( Value ) then Exit;
    y := StrToInt(copy(value, 1, 4));
    m := StrToInt(copy(value, 6, 2));
    d := StrToInt(copy(value, 9, 2));
  end else Exit;

  dt := EncodeDate(Y, M, D);

  Result := dt;
end;

Function DateStrToDateFmt( Const Value, Fmt : String ) : String;
var
  dt: TDateTime;
begin
  Result := '';
  dt := DateStrToDateTime( Value );
  if dt <= 0 then Exit;
  Result := FormatDateTime(Fmt, dt);
end;

Function TimeStrToDateTime( Const Value : String ) : TDateTime;
var
  dt: TDateTime;
  h, n, s: Word;
begin
  Result := 0;
  if Length( Value ) = 4 then begin
    h := StrToInt(copy(value, 1, 2));
    n := StrToInt(copy(value, 3, 2));
    s := 0;
  end else if Length( Value ) = 5 then begin
    h := StrToInt(copy(value, 1, 2));
    n := StrToInt(copy(value, 4, 2));
    s := 0;
  end else if Length( Value ) = 6 then begin
    h := StrToInt(copy(value, 1, 2));
    n := StrToInt(copy(value, 3, 2));
    s := StrToInt(copy(value, 5, 2));
  end else if Length( Value ) = 8 then begin
    h := StrToInt(copy(value, 1, 2));
    n := StrToInt(copy(value, 4, 2));
    s := StrToInt(copy(value, 7, 2));
  end else Exit;

  dt :=  Trunc(now) + EncodeTime(h, n, s, 0);
  Result := dt;
end;
Function TimeStrToDateFmt( Const Value, Fmt : String ) : String;
var
  dt: TDateTime;
begin
  Result := '';
  dt := TimeStrToDateTime( Value );
  if dt <= 0 then Exit;
  Result := FormatDateTime(Fmt, dt);
end;

function DateTimeStrtoDT( const Value : String ) : TDateTime;
var
  y, m, d: Word;
  h, n, s: Word;
begin
  result := now;
  if Length( Value ) <> 14 then Exit;

  y := StrToInt(copy(value, 1, 4));
  m := StrToInt(copy(value, 5, 2));
  d := StrToInt(copy(value, 7, 2));

  h := StrToInt(copy(value, 9, 2));
  n := StrToInt(copy(value,11, 2));
  s := StrToInt(copy(value,13, 2));

  Result := EncodeDate( y, m, d ) + EncodeTime( h, n, s, 0 );
end;

function DTtoDateTimeStr( aDt : TDateTime ) : String;
begin
  Result := FormatDateTime('YYYYMMDDHHNNSS', adt);
end;




end.
